MODEL PROGRAM B0=0 B1=0 B2=0 K1=1.
COMPUTE PRED=B0+B1*(X-K1)*(X LE K1) + B2*(X-K1)*(X GE K1).
DERIVATIVES.
COMPUTE D.B0 = 1.
IF (X LE K1) D.B1=X-K1.
IF (X LE K1) D.B2=0.
IF (X LE K1) D.K1=-B1.
IF (X GT K1) D.B2=X-K1.
IF (X GT K1) D.B1=0.
IF (X GT K1) D.K1=-B2.
CNLR Y
/SAVE PRED
/BOOTSTRAP.

>>>>>>> IN R THE ABOVE SPSS CODE CAN BE WRITTEN AS: MINIMUM OUT1 FOR A GIVEN K: SEEMS TO WORK

>>>> PILOT FIX A K1 (CHANGEPOINT)

npts <- 10

grp <- c(1:npts)
dat <- c(5,9,1,2,5,6,7,8,3,8)
dat <- c(10,10,11,10,11,9,4,2,1,0)

k1 <- 3

gp1 <- rep(0,npts)
gp1 <- (grp[]-k1) * (grp[]-k1 <= 0)
   
gp2 <- rep(0,npts)
gp2 <- (grp[]-k1) * (grp[]-k1 >= 0)

out <- lm(dat ~ gp1 + gp2)
out

rss <- rep(NA,npts)
cpt <- rep(NA,npts)

>>>>>>> PLOT THE DATA

grp <- c(1:npts)
dat <- c(5,9,1,2,5,6,7,8,3,8)
dat <- c(10,10,11,10,11,9,4,2,1,0)

stripchart(grp ~ dat, method = "stack")

>>>>>>>>>>>>>>>>> WORK OUT FOR ALL VALUES OF K1 (CHANGEPOINT)

npts <- 10

grp <- c(1:npts)
dat <- c(5,9,1,2,5,6,7,8,3,8)
dat <- c(10,10,11,10,11,9,4,2,1,0)

rss1 <- rep(NA,npts)

for (k1 in 1:npts) {
gp1 <- rep(0,npts)
gp1 <- (grp[]-k1) * (grp[]-k1 <= 0)
   
gp2 <- rep(0,npts)
gp2 <- (grp[]-k1) * (grp[]-k1 >= 0)

out <- lm(dat ~ gp1 + gp2)
rss1[k1] <- sum(out$residuals^2)
}

print(rss1)

% OBTAIN FITTED VALUES

coor <- which(rss1 == min(rss1,na.rm=TRUE))

k1 <- coor[1]

gp1 <- rep(0,npts)
gp1 <- (grp[]-k1) * (grp[]-k1 <= 0)
   
gp2 <- rep(0,npts)
gp2 <- (grp[]-k1) * (grp[]-k1 >= 0)

out <- lm(dat ~ gp1 + gp2)
out$fitted.values
print(rss1[coor[1]])

>>>>>>>>> PLOT FITTED VALUES

stripchart(grp ~ out$fitted.values, method = "stack")

pdf(file="C:/Documents and Settings/peterw/Desktop/My Documents/My Documents2/knots/cpt1.pdf", height=3.5, width=5)
plot(grp, out$fitted.values,type="n")
lines(grp,out$fitted.values,lty=1)
points(grp,dat,pch=1)
dev.off()

>>>>>>>>>>>>>>>> ISOTONIC REGRESSION ( JUST LOOKS AT CHANGES IN DIRECTION)

grp <- c(1:10)
dat <- c(5,9,1,2,5,6,7,8,3,8)

mu0 <- mean(dat)
sig0 <- sd(dat)
n <- length(dat)
ss.null <- sum((dat - mu0)^2)

xbar <- sapply(split(dat, grp), mean)
nbar <- sapply(split(dat, grp), length)
k <- length(xbar)

pava <- function(x, w) {
    if (any(w <= 0))
        stop("weights must be positive")
    if (length(x) != length(w))
        stop("arguments not same length")
    n <- length(x)
    design <- diag(n)
    repeat {
        out <- lm(x ~ design+0, weights = w)
        print(out)
        mu <- coefficients(out)
        dmu <- diff(mu)
        if (all(dmu >= 0)) break
        j <- min(seq(along = dmu)[dmu < 0])
        design[ , j] <- design[ , j] + design[ , j + 1]
        design <- design[ , - (j + 1), drop = FALSE]
    }
    return(as.numeric(design %*% mu))
}
 
test.stat <- function(x, w) {
    mu <- pava(x, w)
    mu0 <- sum(w * x) / sum(w)
    ss.alt <- sum(w * (x - mu)^2)
    ss.null <- sum(w * (x - mu0)^2)
    return(ss.null - ss.alt)
}

>>>>>>>>>  R CODE FOR	 2 CHANGEPOINTS

>>> FOR GIVEN CHANGEPOINTS K1 AND K2

npts <- 11

grp <- c(1:npts)
dat <- c(10,10,11,10,11,9,4,2,3,5,9)

k1 <- 2
k2 <- 5

gp1 <- rep(0,npts)
gp1 <- (grp[]-k1) * (grp[]-k1 <= 0)
   
gp2 <- rep(0,npts)
gp2 <- (grp[]-k1) * (grp[]-k1 >= 0) * (grp[]-k2 <=0)

gp3 <- rep(0,npts)
gp3 <- (grp[]-k2) * (grp[]-k2 >= 0)

out <- lm(dat ~ gp1 + gp2 + gp3)
sum(out$residuals^2)

>>>>>>> PLOT THE DATA

grp <- c(1:npts)
dat <- c(10,10,11,10,11,9,4,2,3,5,9)

pdf(file="C:/Documents and Settings/peterw/Desktop/My Documents/My Documents2/knots/cpt2.pdf", height=3.5, width=5)
plot(grp, out$fitted.values,type="n")
lines(grp,out$fitted.values,lty=1)
points(grp,dat,pch=1)
dev.off()


>>>>>>>>>>>>>>>>>> LOOPING THROUGH ALL POSSIBLE K1, K2 CHANGEPOINTS

npts <- 11

grp <- c(1:npts)
dat <- c(10,10,11,10,11,9,4,2,3,5,9)

rss2 <- matrix(NA,npts,npts)

for (k1 in 1:npts-1) {
 for (k2 in (k1+1):npts) {
gp1 <- rep(0,npts)
gp1 <- (grp[]-k1) * (grp[]-k1 <= 0)
   
gp2 <- rep(0,npts)
gp2 <- (grp[]-k1) * (grp[]-k1 >= 0) * (grp[]-k2 <=0)

gp3 <- rep(0,npts)
gp3 <- (grp[]-k2) * (grp[]-k2 >= 0)

out <- lm(dat ~ gp1 + gp2 + gp3)
out

rss2[k1,k2] <- sum(out$residuals^2)
}
}

coor <- which(rss2 == min(rss2,na.rm=TRUE), arr.ind = TRUE)


% GET PREDICTED VALUES FOR BEST FITTING MODEL

k1 <- coor[1]
k2 <- coor[2]

gp1 <- rep(0,npts)
gp1 <- (grp[]-k1) * (grp[]-k1 <= 0)
   
gp2 <- rep(0,npts)
gp2 <- (grp[]-k1) * (grp[]-k1 >= 0) * (grp[]-k2 <=0)

gp3 <- rep(0,npts)
gp3 <- (grp[]-k2) * (grp[]-k2 >= 0)

out <- lm(dat ~ gp1 + gp2 + gp3)
out$fitted.values

>>> PLOT FITTED VALUES

pdf(file="C:/Documents and Settings/peterw/Desktop/My Documents/My Documents2/knots/cpt2.pdf", height=3.5, width=5)
plot(grp, out$fitted.values,type="n")
lines(grp,out$fitted.values,lty=1)
points(grp,dat,pch=1)
dev.off()

>> MORE ON PLOTTING IN R IS GIVEN HERE: http://www.harding.edu/fmccown/R/